home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Debugger / RTDT.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-10-27  |  17.4 KB  |  421 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 27 Oct 95
  5. InfoElems
  6. Alloc
  7. Syntax10.Scn.Fnt
  8. StampElems
  9. Alloc
  10. 27 Oct 95
  11. "Title": Run time debugger
  12. "Author": mah
  13. "Abstract": trap handler & lowlevel processor handling
  14. "Keywords": 
  15. "Version": 
  16. "From":  25.10.94 16:53:38
  17. "Until": 
  18. "Changes": 
  19. 10.12.94 separate codeseg for restart instead of removing one trap instr
  20. 26.1.95 separate debugging stack 
  21. 5.4.95 error fixed with local pointers on stack resp. in register
  22. ParcElems
  23. Alloc
  24. Syntax10b.Scn.Fnt
  25. Syntax10i.Scn.Fnt
  26. FoldElems
  27. Syntax10.Scn.Fnt
  28. Syntax10b.Scn.Fnt
  29. Syntax10i.Scn.Fnt
  30.         up*: Proc;                            (* caller of myself *)
  31.         pc*, sp*: LONGINT;
  32.         name*: ARRAY 64 OF CHAR;
  33.         modName*: ARRAY 32 OF CHAR;
  34.         regs*: Sys.ExceptionInfo;
  35.         beginPC*, endPC*: LONGINT
  36.     END;
  37. Syntax10.Scn.Fnt
  38. Syntax10i.Scn.Fnt
  39.                             (* stack copy *)
  40.         size: LONGINT;                        (* size of currently saved stack *)
  41.         adr: LONGINT;                        (* Adress of memory block for debug stack *)
  42.         p: POINTER TO ARRAY OF CHAR    (* Adress of memory block as pointer *)    
  43.     END;
  44. Syntax10.Scn.Fnt
  45. VAR a: LONGINT;
  46. BEGIN
  47.     a := adr - Kernel.resumeSP + stack.adr;
  48.     IF (a < stack.adr) & (a >= stack.adr - stack.size) THEN adr := a END
  49. END ConvertAdr;
  50. Syntax10.Scn.Fnt
  51. VAR n : LONGINT; shift : SHORTINT; x : CHAR;
  52. BEGIN
  53.     shift := 0; n := 0; SYS.GET (refs, x); INC (refs);
  54.     WHILE ORD(x)>=128 DO
  55.         INC (n, ASH (ORD (x) MOD 128, shift));
  56.         INC (shift, 7);
  57.         SYS.GET (refs, x); INC (refs)
  58.     END;
  59.     k := n + ASH (ORD (x) MOD 64, shift) - ASH (ORD (x) DIV 64, shift) * 64
  60. END RInt;
  61. Syntax10.Scn.Fnt
  62. VAR i  : INTEGER; ch : CHAR;
  63. BEGIN i := 0; REPEAT SYS.GET (refs, ch); name[i] := ch; INC (i); INC (refs) UNTIL ch = 0X
  64. END RName;
  65. Syntax10.Scn.Fnt
  66. BEGIN
  67.     IF dest = NIL THEN NEW (dest); NEW (dest.spec); NEW (dest.reg); NEW (dest.fp) END;
  68.     dest.kind := src.kind;
  69.     dest.spec^ := src.spec^; dest.reg^ := src.reg^; dest.fp^ := src.fp^
  70. END MoveRegs;
  71. Syntax10.Scn.Fnt
  72. BEGIN
  73.     Kernel.RemoveStack (stack.adr);
  74.     IF newSize # 0 THEN Kernel.AddStack (stack.adr, stack.adr - newSize) END
  75. END SetStackLen;
  76. Syntax10.Scn.Fnt
  77. Syntax10i.Scn.Fnt
  78. (* find mod, refstart, refend, startpc and endpc of a procedure given by a pc *)
  79.     m: Modules.Module;
  80.     ref, p: LONGINT;
  81.     ch: CHAR;
  82. BEGIN
  83.     m := Modules.modules; mod := NIL; refpos := -1;
  84.     WHILE (m # NIL) & ((pc < m.PC) OR (m.PC+m.codesize*4 < pc)) DO m := m.link END;
  85.     IF m # NIL THEN
  86.         mod := m; pc := (pc - m.PC) DIV 4;
  87.         ref := m.refs; refend := ref; p := 0; startpc := 0;
  88.         IF mod.refs # 0 THEN INC(refend, mod.refsize) END;
  89.         LOOP
  90.             IF ref >= refend THEN EXIT END;
  91.             SYS.GET(ref, ch); INC(ref);
  92.             IF ch = 0F8X THEN
  93.                 startpc := 4 * p; RInt(ref, p); endpc := 4 * p;
  94.                 IF p > pc THEN refpos := ref; EXIT END
  95.             END
  96.         END
  97. END SearchProc;
  98. Syntax10.Scn.Fnt
  99. VAR p, tmp: Proc;
  100. BEGIN
  101.     (* invert old *)
  102.     p := old; old := NIL;
  103.     WHILE p # NIL DO tmp := p.up; p. up := old; old := p; p := tmp END;
  104.     p := procs;
  105.     WHILE (old # NIL) & (p # NIL) & (old.sp = p.sp) & (old.beginPC = p.beginPC) DO    (* same proc on same stack pos *)
  106.         tmp := p.up;
  107.         old.regs^ := p.regs^;
  108.         p^ := old^;
  109.         p.up := tmp;
  110.         p := p.up; old := old.up
  111.     END;
  112.     (* invert proc *)
  113.     p := procs; procs := NIL;
  114.     WHILE p # NIL DO tmp := p.up; p. up := procs; procs := p; p := tmp END
  115. END Mix;
  116. Syntax10.Scn.Fnt
  117. Syntax10i.Scn.Fnt
  118.  scan stack for procedure information 
  119. Syntax10.Scn.Fnt
  120.         VAR pos, len, instr: LONGINT; trap : Modules.TrapDescPtr; 
  121.     BEGIN
  122.         SYS.GET (pc, instr);
  123.         pc := (pc - mod.PC) DIV 4;
  124.         pos := 0; len := 0; IF mod.traps # 0 THEN len := mod.noftraps END;
  125.         trap:= SYS.VAL (Modules.TrapDescPtr, mod.traps);
  126.         WHILE (pos < len) & (pc # trap.offset) DO
  127.             INC(pos);
  128.             trap:=SYS.VAL (Modules.TrapDescPtr, SYS.VAL (LONGINT, trap)+4)
  129.         END;
  130.         IF pos < len THEN
  131.             IF trap.trapno = EnterDebugMode THEN RETURN EnterDebugMode 
  132.             ELSIF instr # itw THEN RETURN trap.trapno
  133.             END
  134.         ELSIF instr # itw THEN RETURN OtherTrap
  135.         END;
  136.         RETURN Breakpoint
  137. END GetTrapClass;
  138. Syntax10.Scn.Fnt
  139. FoldElems
  140. Syntax10.Scn.Fnt
  141. PictElems
  142. Alloc
  143. bc codeseg[2]
  144. codeseg[0]
  145. codeseg[1]
  146. codeseg[2]
  147. b target
  148.     bc target
  149. b target
  150. b next instr
  151.     all other
  152.  restart with instruction 'instr'
  153. instr = 
  154. instr
  155. b next instr
  156. b target
  157. LR=PC(Instr)+4
  158. bc codeseg[2](
  159. codeseg[0]0
  160. codeseg[1]*
  161. codeseg[2])i
  162. b target(
  163. v    bc target){
  164. b target(
  165. b next instr(
  166. f    all other(
  167.  restart with instruction 'instr'(
  168. instr = (
  169. instr(
  170. b next instr(
  171. b target(
  172. LR=PC(Instr)+4
  173. Syntax10i.Scn.Fnt
  174. (*---------------------------------------------------------------------------------------------
  175.  Graphical description 
  176. ----------------------------------------------------------------------------------------------*)
  177. VAR target: LONGINT; s: SET; val: INTEGER;
  178. BEGIN
  179.     codeseg[0] := LatestTrapInstr (ctx.spec.PC);
  180.     s := SYS.VAL (SET, codeseg[0]) * {0..5, 30};
  181.     IF s = {1} THEN                                (* relative branch conditional *)
  182.         target := SYS.VAL (LONGINT, SYS.VAL (SET, codeseg[0]) * {16..29});
  183.         SYS.GET (SYS.ADR (target)+2, val);
  184.         target := val + ctx.spec.PC;
  185.         codeseg[0] := SYS.VAL (LONGINT, SYS.VAL (SET, codeseg[0]) * {0..15, 30, 31} + {28});
  186.         codeseg[2] := SYS.VAL (LONGINT, SYS.VAL (SET, ib) + SYS.VAL (SET, target))
  187.     ELSIF s = {1, 4} THEN                            (* relative branch unconditional *)
  188.         s := SYS.VAL (SET, codeseg[0]) * {6..29};
  189.         IF 6 IN s THEN s := s + {0..5} END;
  190.         target := ctx.spec.PC + SYS.VAL (LONGINT, s) - SYS.ADR (codeseg[0]);
  191.         codeseg[0] := SYS.VAL (LONGINT, SYS.VAL (SET, ib) + SYS.VAL (SET, target) * {6..29} - {30, 31});
  192.         ctx.spec.LR := ctx.spec.PC + 4
  193.     END;
  194.     codeseg[1] :=SYS.VAL (LONGINT, SYS.VAL (SET, ib) + SYS.VAL (SET, ctx.spec.PC+4)); 
  195.     ctx.spec.PC := SYS.ADR (codeseg[0]);
  196.     MakeDataExecutable (SYS.ADR (codeseg[0]), 12)
  197. END SetStartSegment;
  198. Syntax10.Scn.Fnt
  199. VAR dummy: Sys.ExceptionHandler;
  200. BEGIN 
  201.     dummy := Sys.InstallExceptionHandler (OldTrap); OldTrap := NIL;
  202.     SetStackLen (0); stack.p := NIL;
  203.     Kernel.RemoveStack (SYS.ADR (regs.reg.R[62]));
  204. END Uninstall;
  205. Syntax10.Scn.Fnt
  206. Syntax10i.Scn.Fnt
  207. (* stop debugging (precondition: debugMode # 0) *)
  208. BEGIN
  209.     debugMode := 0;
  210.     debugQ.Handle
  211. END Stop;
  212. Syntax10.Scn.Fnt
  213. BEGIN RETURN debugMode = 2
  214. END Debugging;
  215. Syntax10.Scn.Fnt
  216. BEGIN RETURN debugMode = 1
  217. END Launching;
  218. Syntax10.Scn.Fnt
  219. Syntax10i.Scn.Fnt
  220. (* TRAP handler *)
  221. VAR retval, sp: LONGINT; w: Texts.Writer; end: BOOLEAN; p: Proc;
  222. BEGIN
  223.     IF traplevel # 0 THEN
  224.         traplevel := 0;
  225.         Texts.OpenWriter (w);
  226.         Texts.WriteString (w, "Debug: recursive trap at "); Texts.WriteHex (w, ctx.spec.PC); Texts.WriteLn (w);
  227.         Texts.Append (Oberon.Log, w.buf);
  228.         IF debugMode # 0 THEN Stop END;
  229.         Kernel.Resume (ctx);
  230.         RETURN 0
  231.     END;
  232.     IF ctx.spec.PC = Macintosh.kbdIntPC THEN        (* kbd Interrupt *)
  233.         SYS.PUT (Macintosh.kbdIntPC, Macintosh.kbdIntInstr);
  234.         Macintosh.kbdIntPC := 0;
  235.         retval := OldTrap (ctx);
  236.         IF Debugging () THEN Stop END;
  237.         Kernel.Resume (ctx);
  238.         RETURN 0
  239.     END;
  240.     IF Debugging () OR Launching () THEN INC (traplevel); retval := Collect (ctx); DEC (traplevel) ELSE retval := -1 END;
  241.     IF retval # 0 THEN
  242.         MoveRegs (ctx, regs);
  243.         sp := ctx.reg.R[SP];
  244.         stack.size := Kernel.resumeSP - sp;
  245.         SYS.MOVE (sp, stack.adr - stack.size, stack.size); SetStackLen (stack.size);
  246.         ScanStack (regs.spec.PC, sp);
  247.         IF ~Debugging () THEN
  248.             p := procs;
  249.             WHILE p # NIL DO
  250.                 p.regs.reg.R[FP] := p.regs.reg.R[FP] - Kernel.resumeSP + stack.adr;
  251.                 p := p.up
  252.             END
  253.         END;
  254.         retval := OldTrap (ctx);
  255.         IF Debugging () THEN Stop END;
  256.         Kernel.Resume (ctx)
  257.     END;
  258.     RETURN 0
  259. END Trap;
  260. Syntax10.Scn.Fnt
  261. BEGIN
  262.     IF OldTrap = NIL THEN
  263.         OldTrap := Sys.InstallExceptionHandler (Trap);
  264.         traplevel := 0; debugMode := 0;
  265.         NEW (regs); NEW (regs.spec); NEW (regs.reg); NEW (regs.fp);
  266.         Kernel.AddStack (SYS.ADR (regs.reg.R[62]), SYS.ADR (regs.reg.R[0]));
  267.         NEW (stack.p, StackSize); stack.adr := SYS.ADR (stack.p[0]) + StackSize
  268. END Install;
  269. Syntax10.Scn.Fnt
  270. Syntax10i.Scn.Fnt
  271. (* prepare debugging (precondition: debugMode = 0) *)
  272. BEGIN
  273.     debugMode := 1                            (* launch debugger mode *)
  274. END Prepare;
  275. Syntax10.Scn.Fnt
  276. BEGIN RETURN regs.spec.PC
  277. END PC;
  278. Syntax10.Scn.Fnt
  279. BEGIN IF procs # NIL THEN procs := procs.up END
  280. END PopProc;
  281. Syntax10.Scn.Fnt
  282.     i, j : LONGINT;
  283.     mod  : Modules.Module;
  284.     r, rr: LONGINT;
  285.     n    : ARRAY 64 OF CHAR;
  286. BEGIN
  287.     name[0] := 0X;
  288.     SearchProc (startPC, mod, r, rr, i, i);
  289.     IF mod = NIL THEN RETURN END;
  290.     RInt(r, i); RInt(r, i); RInt(r, i); RInt(r, i); RInt(r, i); INC(r);
  291.     RName (r, n);
  292.     COPY (mod.name, name);
  293.     i := 0; WHILE name[i] # 0X DO INC (i) END;
  294.     name[i] := '.';
  295.     j := 0; WHILE n[j] # 0X DO name[i+j+1] := n[j]; INC (j) END;
  296.     name[i+j+1] := 0X
  297. END FindProc;
  298. MODULE RTDT; (* Run time debugger: Traphandling; mah 25.10.94 (
  299. IMPORT Modules, Texts, SYS := SYSTEM, Sys, Oberon, Kernel, Input, Macintosh, Out;
  300. CONST
  301.     EnterDebugMode* = 255;                (* trap number to enter debugmode *)
  302.     Breakpoint = -1;                            (* trap number of a breakpoint *)
  303.     OtherTrap = -2;                            (* trap not controlled by debugger *)
  304.     SB = 2*2+1;                                (* static base register 2 *)
  305.     SP = 1*2+1;                                (* stack pointer register 1 *)
  306.     FP = 31*2+1;                            (* frame pointer register 31 *)
  307.     ib = 48000002H;
  308.     itw* = 7FE00008H;
  309.     inop* = 60000000H;
  310.     StackSize* = 50 * 1024;                    (* size of debugging stack *)
  311.     Proc*=POINTER TO ProcDesc;
  312.     ProcDesc*=RECORD 
  313.     debugQ-: Kernel.Queue;                (* queue handled when a debuging step has been finished *)
  314.     startQ-: Kernel.Queue;                    (* queue handled when a debuging step is about to be started *)
  315.     LatestTrapInstr*: PROCEDURE (pc: LONGINT) : LONGINT;    (* up-call to fetch instruction at latest position pc *)
  316.     procs-: Proc;                            (* list of procedures currently on stack *)
  317.     debugMode: INTEGER;                    (* 0->off, 1->launching, 2->debugging *)
  318.     OldTrap: Sys.ExceptionHandler;            (* old system trap handler (Kernel.Trap) only valid if debugging=TRUE *)
  319.     traplevel: INTEGER;                        (* depth of trap recursion, only valid if debugging=TRUE *)
  320.     regs: Sys.ExceptionInfo;                    (* current register set of debugged program.*)
  321.     stack: RECORD
  322.     codeseg: ARRAY 3 OF LONGINT;        (* dummy codesegment to start next step *)
  323.     dbgPar: Oberon.ParList;                    (* parameter of debug mode *)
  324.     MakeDataExecutable: PROCEDURE (base, len: LONGINT);
  325. PROCEDURE ConvertAdr* (VAR adr: LONGINT);
  326. PROCEDURE RInt (VAR refs: LONGINT; VAR k: LONGINT);
  327.  read integer from reference information 
  328. PROCEDURE RName (VAR refs:LONGINT; VAR name:ARRAY OF CHAR);
  329.  read name from reference information 
  330. PROCEDURE MoveRegs (VAR src, dest: Sys.ExceptionInfo);
  331.  Copies an exception info structure (deep copy) 
  332. PROCEDURE SetStackLen (newSize: LONGINT);
  333.  sets currently used length of the stack copy 
  334. PROCEDURE SearchProc* (pc: LONGINT; VAR mod: Modules.Module; VAR refpos, refend, startpc, endpc: LONGINT);
  335. PROCEDURE Mix (old: Proc);
  336.  mix new stack description with old one (reuse same memory where possible) 
  337. PROCEDURE ScanStack (pc, sp: LONGINT);
  338.     new, old: Proc;
  339.     ref, refend, p, fsize, psize, ralloc, falloc, calloc, nofFrames: LONGINT;
  340.     leaf: BOOLEAN;
  341.     mod : Modules.Module;
  342.     stackRegs: Sys.ExceptionInfo;
  343. BEGIN
  344.     nofFrames:=0; old := procs; procs := NIL;
  345.     MoveRegs (regs, stackRegs);
  346.     WHILE (sp <= Kernel.resumeSP) & (nofFrames < 64) DO
  347.         NEW (new); new.up := procs; procs := new;
  348.         new.pc := pc; new.sp := sp;
  349.         MoveRegs (stackRegs, new.regs);
  350.         SearchProc (pc, mod, ref, refend, new.beginPC, new.endPC);
  351.         IF mod = NIL THEN procs := procs.up; Mix (old); RETURN END;
  352.         COPY (mod.name, new.modName);
  353.         IF ref > 0 THEN
  354.             RInt (ref, fsize); RInt (ref, psize); RInt(ref, ralloc);
  355.             RInt (ref, falloc); RInt (ref, calloc);
  356.             SYS.GET (ref, leaf); INC (ref);
  357.             RName (ref, new.name);
  358. (*            new.regs.reg.R[FP] := new.regs.reg.R[FP] - Kernel.resumeSP + stack.adr; *)
  359.             SYS.GET(sp, sp);
  360.             IF leaf THEN pc := stackRegs.spec.LR ELSE SYS.GET(sp+8, pc) END;
  361.             p := sp - (31 - ralloc) * 4;
  362.             WHILE ralloc < 31 DO INC (ralloc); SYS.GET (p, stackRegs.reg.R[2*ralloc+1]); INC (p, 4) END;
  363.             INC (p, (-p) MOD 8);
  364.             WHILE falloc < 31 DO INC (falloc); SYS.GET (p, stackRegs.fp.R[2*falloc+1]); INC (p, 8) END;
  365.             IF calloc < 19 THEN SYS.GET (sp+4, stackRegs.spec.CR) END
  366.         ELSE
  367.             SYS.GET (sp, sp); SYS.GET (sp + 8, pc)
  368.         END;
  369.         IF (new.name = "Loop") & (new.modName = "Oberon") THEN Mix (old); RETURN END;
  370.         INC (nofFrames)
  371. END ScanStack;
  372. PROCEDURE GetTrapClass (mod: Modules.Module; pc: LONGINT) : INTEGER;
  373. PROCEDURE SetStartSegment (VAR ctx: Sys.ExceptionInfo);
  374.  generate dummy code segment to skip initial bp 
  375. PROCEDURE Collect (VAR ctx: Sys.ExceptionInfo) : LONGINT;
  376.     sp, refpos, refend, dummy: LONGINT;
  377.     mod: Modules.Module;
  378.     class, x, y: INTEGER;
  379.     keys: SET;
  380. BEGIN
  381.     IF debugMode = 0 THEN RETURN -1 END;
  382.     SearchProc (ctx.spec.PC, mod, refpos, refend, dummy, dummy);
  383.     IF (ctx.kind # 2) OR (mod = NIL) THEN RETURN -1 END;
  384.     class := GetTrapClass (mod, ctx.spec.PC);
  385.     IF (class # EnterDebugMode) & (class # Breakpoint) THEN RETURN -1 END;
  386.     IF class = Breakpoint THEN
  387.         debugMode := 2;
  388.         dbgPar.text := Oberon.Par.text; dbgPar.pos := Oberon.Par.pos;
  389.         sp := ctx.reg.R[SP];
  390.         MoveRegs (ctx, regs);
  391.         stack.size := Kernel.resumeSP-sp; 
  392.         SYS.MOVE (sp, stack.adr - stack.size, stack.size);
  393.         SetStackLen (stack.size); 
  394.         ScanStack (regs.spec.PC, sp); 
  395.         debugQ.Handle;
  396.         Kernel.Resume (ctx);
  397.         RETURN 0
  398.     END;
  399.     startQ.Handle;
  400.     Oberon.Par.pos := dbgPar.pos; Oberon.Par.text := dbgPar.text;
  401.     MoveRegs (regs, ctx);
  402.     SYS.MOVE (stack.adr - stack.size, Kernel.resumeSP - stack.size, stack.size);
  403.     SetStartSegment (ctx);
  404.     RETURN 0
  405. END Collect;
  406. PROCEDURE Uninstall*;
  407. PROCEDURE Stop*;
  408. PROCEDURE Debugging* () : BOOLEAN;
  409. PROCEDURE Launching* () : BOOLEAN;
  410. PROCEDURE Trap (ctx: Sys.ExceptionInfo) : LONGINT;
  411. PROCEDURE Install*;
  412. PROCEDURE Prepare*;
  413. PROCEDURE PC* () : LONGINT;
  414. PROCEDURE PopProc*;
  415. PROCEDURE FindProc* (startPC: LONGINT; VAR name: ARRAY OF CHAR);
  416.  Get name of procedure starting at startPC 
  417. BEGIN
  418.     debugQ.Init; startQ.Init; OldTrap := NIL; NEW (dbgPar);
  419.     Sys.Assign ("MakeDataExecutable", SYS.ADR (MakeDataExecutable))
  420. END RTDT.
  421.